!======================================================================
!
!    HEEDS (Higher Education Enrollment Decision Support) - A program
!      to create enrollment scenarios for 'next term' in a university
!    Copyright (C) 2012, 2013 Ricolindo L Carino
!
!    This file is part of the HEEDS program.
!
!    HEEDS is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    HEEDS is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with this program (see the file COPYING.TXT). If not, see
!    <http://www.gnu.org/licenses/>.
!
!    Send inquiries about HEEDS to:
!      Ricolindo L Carino
!      E-mail: Ricolindo.Carino@AcademicForecasts.com
!      Address: 600 Cruise St., Starkville, MS 39759, U.S.A.
!
!======================================================================


module ROOMS

    use DEPARTMENTS


    implicit none

    ! room variables
    integer, parameter :: &
        MAX_ALL_ROOMS = 1000, & ! room names
        MAX_LEN_ROOM_CODE=16          ! length of room code

    type :: TYPE_ROOM
        character (len=MAX_LEN_ROOM_CODE) :: Code
        integer :: DeptIdx, Cluster, MaxCapacity
    end type TYPE_ROOM

    type (TYPE_ROOM), dimension(0:MAX_ALL_ROOMS) :: Room
    integer :: NumRooms, NumAdditionalRooms

    ! private tokens
    character (len=MAX_LEN_FILE_PATH), private :: fileName
    character (len=MAX_LEN_XML_LINE), private :: line
    integer, private :: unitNum=2, eof, ndels, pos(30)

contains

#include "custom_read_rooms.F90"


    subroutine read_rooms(path, errNo)

        character(len=*), intent(in) :: path
        integer, intent (out) :: errNo

        logical :: noXML

        NumRooms = 0
        NumAdditionalRooms = 0
        call initialize_room (Room(0))
        Room = Room(0)
        Room(0)%Code = 'TBA' ! for 'Room not found!'

        noXML = .false.
        call xml_read_rooms(path, errNo) ! try the XML file
        if (errNo/=0) then ! something wrong with XML file
            noXML = .true.
            call  custom_read_rooms(path, errNo) ! try custom format
            if (errNo/=0) return ! something still wrong
        end if

        ! write the XML ROOMS file?
        if (noXML .and. NumRooms>0) call xml_write_rooms(path)

        return
    end subroutine read_rooms


    subroutine initialize_room (wrkRoom, tCode, iDept, iCluster, iCapacity)

        type(TYPE_ROOM), intent (out) :: wrkRoom
        character(len=*), intent (in), optional :: tCode
        integer, intent (in), optional :: iDept, iCluster, iCapacity

        character (len=MAX_LEN_DEPARTMENT_CODE) :: tDept

        if (present(tCode)) then
            wrkRoom = TYPE_ROOM(tCode, iDept, iCluster, iCapacity)

        else
            tDept = REGISTRAR
            wrkRoom = TYPE_ROOM(SPACE, index_to_dept(tDept), 0, 0)

        end if

        return
    end subroutine initialize_room


    function index_to_room (tRoom)

        integer :: index_to_room
        character (len=MAX_LEN_ROOM_CODE), intent (in) :: tRoom

        integer :: i, j, rdx

        ! try the newly added rooms
        do rdx=NumRooms+1,NumRooms+NumAdditionalRooms
            if (tRoom==Room(rdx)%Code) then
                index_to_room = rdx
                return
            end if
        end do

        ! try the orignal rooms
        i = 1
        j = NumRooms
        do
            if (i>j) then
                rdx = 0
                exit
            else
                rdx = (i + j)/2
                if (tRoom==Room(rdx)%Code) then
                    exit
                else if (tRoom<Room(rdx)%Code) then
                    j = rdx-1
                else
                    i = rdx+1
                end if
            end if
        end do
        index_to_room = rdx

        return
    end function index_to_room


    subroutine sort_rooms()

        type(TYPE_ROOM) :: wrkRoom
        integer :: i, j

        ! sort
        do i=1,NumRooms-1

            do j=i+1,NumRooms
                if (Room(i)%Code>Room(j)%Code) then

                    wrkRoom = Room(i)
                    Room(i) = Room(j)
                    Room(j) = wrkRoom

                end if
            end do

        end do

        return
    end subroutine sort_rooms


    subroutine xml_write_rooms(path)

        character(len=*), intent(in) :: path
        integer :: ldx

        ! training only?
        if (noWrites) return

        fileName = trim(dirXML)//trim(path)//'ROOMS.XML'
        call xml_open_file(unitNum, XML_ROOT_ROOMS, fileName, ldx)

        write(unitNum,AFORMAT) &
        '    <comment>', &
        '        Generated by '//PROGNAME//VERSION//' on '//currentDate(1:4)// &
                    FSLASH//currentDate(5:6)//FSLASH//currentDate(7:8), &
        '        Code - room code', &
        '        Department - responsible department', &
        '        Cluster - rooms with the same cluster are "within walking distance" of each other', &
        '        MaxCapacity- maximum seating capacity', &
        '    </comment>'

        do ldx = 1,NumRooms+NumAdditionalRooms
            call xml_write_character(unitNum, indent0, 'Room')
            call xml_write_character(unitNum, indent1, 'Code', Room(ldx)%Code)
            call xml_write_character(unitNum, indent1, 'Department', Department(Room(ldx)%DeptIdx)%Code)
            call xml_write_integer(unitNum, indent1, 'Cluster', Room(ldx)%Cluster)
            call xml_write_integer(unitNum, indent1, 'MaxCapacity', Room(ldx)%MaxCapacity)
            call xml_write_character(unitNum, indent0, '/Room')
        end do

        call xml_close_file(unitNum, XML_ROOT_ROOMS)

        return
    end subroutine xml_write_rooms


    subroutine xml_read_rooms(path, errNo)

        character(len=*), intent(in) :: path
        integer, intent (out) :: errNo

        integer :: j
        character(len=MAX_LEN_XML_LINE) :: value
        character(len=MAX_LEN_XML_TAG) :: tag
        type(TYPE_ROOM) :: wrkRoom
        character (len=MAX_LEN_DEPARTMENT_CODE) :: tDept

        ! open file, return on any error
        fileName = trim(dirXML)//trim(path)//'ROOMS.XML'
        call xml_open_file(unitNum, XML_ROOT_ROOMS, fileName, errNo, forReading)
        if (errNo/=0) return

        ! examine the file line by line
        do

            read(unitNum, AFORMAT, iostat=eof) line
            if (eof<0) exit

            ! get tag and value if any; exit on any error
            call xml_parse_line(line, tag, value, eof)
            if (eof/=0) exit

            select case (trim(tag))

                case ('Room') ! initialize temporary room data
                    call initialize_room (wrkRoom)

                case ('Code')
                    wrkRoom%Code = adjustl(value)

                case ('Department')
                    tDept = adjustl(value)
                    j = index_to_dept(tDept)
                    if (j==0) j = NumDepartments ! use REGISTRAR if tDept not in list of departments
                    wrkRoom%DeptIdx = j

                case ('Cluster')
                    wrkRoom%Cluster = atoi(value)

                case ('MaxCapacity')
                    wrkRoom%MaxCapacity = atoi(value)

                case ('/Room') ! add temporary room data to Room()
                    NumRooms = NumRooms + 1
                    call check_array_bound (NumRooms, MAX_ALL_ROOMS, 'MAX_ALL_ROOMS')
                    Room(NumRooms) = wrkRoom

                    Department(wrkRoom%DeptIdx)%hasInfo = .true.

                case default
                ! do nothing

            end select

        end do
        call xml_close_file(unitNum)

        call sort_rooms()

        return
    end subroutine xml_read_rooms


end module ROOMS
